home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / HUGS1 / hs / lucqs < prev    next >
Text File  |  1995-02-25  |  2KB  |  73 lines
  1. -- A `prettier' version of the 8 queens program that displays the
  2. -- solutions to the 8 queens problems on chess boards ... you need
  3. -- a terminal that uses standard ANSI (I think) control sequences
  4. -- to switch between normal and inverse video to use this program.
  5. --
  6. -- Written by Luc Duponcheel, March 1993
  7.  
  8. -- this is standard
  9.  
  10. row n = [(n,m) | m <- [1..8]]
  11.  
  12. qss 0 = [[]]
  13. qss n = [ q:qs | qs <- qss (n-1) , q <- row n, all (ok q) qs]
  14.  
  15. ok (m,n) (i,j) = j/=n && (i+j/=m+n) && (i-j/=m-n)
  16.  
  17. -- fold is (among others) useful for showing lists WITHOUT '[' , ',' , ']'
  18. -- BTW the definition of fold is similar to the one of map
  19. -- fold and map can easily be generalised 
  20.  
  21. fold :: (a -> b -> b) -> [a] -> b -> b
  22. fold f [] = id
  23. fold f (x:xs) = f x . fold f xs
  24.  
  25. -- For inverse video
  26.  
  27. inv = "" -- [chr 27] ++ "[7m"
  28. res = "" -- [chr 27] ++ "[m"
  29.  
  30. -- how to show Blanks and Queens
  31.  
  32. data Mode  = Md   (Int,Int)
  33.  
  34. data Queen = Qn   (Int,Int)
  35. data Blank = Blnk (Int,Int)
  36.  
  37. instance Text Mode where
  38.     showsPrec p (Md (n,m)) | even s = showString inv
  39.                            | odd  s = showString res
  40.                                  where s = (n+m)
  41.  
  42. instance Text Queen where
  43.     showsPrec p (Qn (n,m))   = shows (Md (n,m)) . showString "++"
  44.                          
  45.  
  46. instance Text Blank where
  47.     showsPrec p (Blnk (n,m)) = shows (Md (n,m)) . showString "  "
  48.         showList = fold shows
  49.  
  50. blanksBefore (n,m) = [Blnk (n,i) | i <- [1..(m-1)]] 
  51. blanksAfter  (n,m) = [Blnk (n,i) | i <- [(m+1)..8]] 
  52.  
  53. -- how to show Rows and Boards
  54.  
  55. data Row   = Rw  (Int,Int)
  56. data Board = Brd [Row]
  57.  
  58.  
  59. instance Text Row where
  60.     showsPrec p (Rw q)
  61.       = showChar '\t' . shows (blanksBefore q) 
  62.             . shows (Qn q) . 
  63.             shows (blanksAfter q) . showString res . showChar '\n'
  64.  
  65. instance Text Board where
  66.     showsPrec p (Brd qs) = showChar '\n' . fold shows qs . showChar '\n'
  67.         showList = fold shows
  68.    
  69. main :: Dialogue
  70. main = appendChan stdout solutions exit done
  71.        where solutions = show ([Brd [Rw q | q <- qs] | qs <- (qss 8)])
  72.  
  73.